home *** CD-ROM | disk | FTP | other *** search
/ MacGames Sampler / PHT MacGames Bundle.iso / MacSource Folder / Samples from the CD / Editors / emacs / Emacs-1.14b1 / lisp / think-c / tc-reply.el < prev    next >
Encoding:
Text File  |  1994-03-08  |  5.9 KB  |  177 lines  |  [TEXT/EMAC]
  1. ;;;
  2. ;;; Code to receive Apple events from Think C
  3. ;;;
  4.  
  5. (defun tc:do-build-reply (event history)
  6.   (announce-reply history)
  7.   (catch 'failure
  8.     (let* ((dataSize (make-string 4 0))
  9.            (typeCode (make-string 4 0))
  10.            (err (AESizeOfParam event keyLinkError typeCode dataSize)))
  11.       (cond
  12.        ((= err errAEDescNotFound)
  13.         (insert-reply "  No link errors.\n"))
  14.        ((not (zerop err))
  15.         (insert-reply "  Could not read link errors, got error "
  16.                       (error-string err) ".\n")
  17.         (throw 'failure err))
  18.        (t
  19.         (let* ((dataPtr (make-string (extract-internal dataSize 0 'unsigned-long) 0))
  20.                (actualSize (make-string 4 0))
  21.                (err (AEGetParamPtr event keyLinkError typeChar typeCode
  22.                                    dataPtr dataSize actualSize)))
  23.           (cond
  24.            ((not (zerop err))
  25.             (insert-reply "  Could not read link errors, got error "
  26.                           (error-string err) ".\n")
  27.             (throw 'failure err))
  28.            (t
  29.             (insert-reply "  Link errors:\n"
  30.                           "Warning: Think C sends garbage with its link errors!\n"
  31.                           "Warning: Use “Check Link” in Think C for a full list of link errors!\n"
  32.                           "Here are the first 50 characters of the link errors:\n"
  33.                           (substring dataPtr 0 50)
  34.                           "\n")))))))
  35.     
  36.     (let* ((error-number-data (make-string 4 0))
  37.            (returnedType (make-string 4 0))
  38.            (actualSize (make-string 4 0))
  39.            (err (AEGetParamPtr event keyErrorNumber
  40.                                typeLongInteger returnedType
  41.                                error-number-data 4 actualSize)))
  42.       (cond
  43.        ((zerop err)
  44.         (let ((error-number (extract-internal error-number-data 0 'long)))
  45.           (insert-reply "  Error number returned in reply is "
  46.                         (error-string error-number)
  47.                         ".\n")))
  48.        ((= err errAEDescNotFound)
  49.         nil)
  50.        (t
  51.         (insert-reply "  Could not read error number of reply, got error "
  52.                       (error-string error-number)
  53.                       ".\n")
  54.         (throw 'failure err))))
  55.     
  56.     noErr))
  57.  
  58. (defun tc:do-compile-reply (event history)
  59.   (announce-reply history)
  60.   (let* ((returnedType (make-string 4 0))
  61.          (successful-compile-data (make-string 1 0))
  62.          (actualSize (make-string 4 0))
  63.          (flavor (cdr (assoc 'flavor history)))
  64.          (successful-compile
  65.           (let ((err (AEGetParamPtr event keyCompiled typeBoolean
  66.                                     returnedType successful-compile-data 1 actualSize)))
  67.             (if (zerop err)
  68.                 (not (zerop (extract-internal successful-compile-data 0 'char)))
  69.               nil))))
  70.     
  71.     (if successful-compile
  72.         (cond
  73.          ((equal flavor kCompile)
  74.           (insert-reply "  Successful compilation.\n"))
  75.          
  76.          ((equal flavor kMake)
  77.           (insert-reply "  Successful make.\n"))
  78.          
  79.          ((or (equal flavor kDisassemble)
  80.               (equal flavor kPreprocess))
  81.           (cond
  82.            ((equal flavor kDisassemble)
  83.             (insert-reply "  Successful disassembly.\n"))
  84.            ((equal flavor kPreprocess)
  85.             (insert-reply "  Successful preprocessing.\n")))
  86.           
  87.           (let* ((output-list (make-string sizeof-AEDesc 0))
  88.                  (err (AEGetParamDesc event keyAEResult typeAEList output-list)))
  89.             (if (not (zerop err))
  90.                 (insert-reply "  Can't read results.\n")
  91.               (let* ((items-in-list (make-string 4 0))
  92.                      (err (AECountItems output-list items-in-list)))
  93.                 (if (not (zerop err))
  94.                     (insert-reply "  Can't read results.\n")
  95.                   (let ((items-in-list (extract-internal items-in-list 0 'long)))
  96.                     (if (zerop items-in-list)
  97.                         (insert-reply "  No results returned.\n")
  98.                       (let ((buffer (generate-new-buffer
  99.                                      (cond
  100.                                       ((equal flavor kDisassemble) "*disassembly*")
  101.                                       ((equal flavor kPreprocess) "*preprocess*")))))
  102.                         (set-buffer buffer)
  103.                         (set-window-buffer (get-largest-window) buffer)
  104.                         (get-one-string (string-data output-list) 1 items-in-list)
  105.                         (subst-char-in-region (point-min) (point-max) 13 10 t)))))
  106.                 (AEDisposeDesc output-list)))))
  107.          
  108.          ((equal flavor kCheckSyntax)
  109.           (insert-reply "  Syntax is okay.\n")))
  110.       
  111.       ;;; Unsuccessful compilation
  112.       (progn
  113.         (let* ((error-number-data (make-string 4 0))
  114.                (returnedType (make-string 4 0))
  115.                (actualSize (make-string 4 0))
  116.                (err (AEGetParamPtr event keyErrorNumber
  117.                                    typeLongInteger returnedType
  118.                                    error-number-data sizeof-int actualSize)))
  119.           (if (zerop err)
  120.               (let ((error-number (extract-internal error-number-data 0 'long)))
  121.                 (insert-reply "  Error "
  122.                               (error-string error-number)
  123.                               "\n")))
  124.           
  125.           (let* ((error-list-desc (make-string sizeof-AEDesc 0))
  126.                  (err (AEGetParamDesc event keyCompileError typeAEList error-list-desc)))
  127.             (if (zerop err)
  128.                 (progn
  129.                   (let ((items-in-list (make-string 4 0)))
  130.                     (let ((err (AECountItems error-list-desc items-in-list)))
  131.                       (if (zerop err)
  132.                           (let ((items-in-list (extract-internal items-in-list 0 'long)))
  133.                             (get-error-messages error-list-desc 1 items-in-list)))))
  134.                   (AEDisposeDesc error-list-desc))))))))
  135.   (bring-emacs-to-the-front)
  136.   noErr)
  137.  
  138. (defun get-one-string (string-list i n)
  139.   (if (> i n)
  140.       nil
  141.     (let ((data (read-one-list-item string-list i)))
  142.       (if (null data)
  143.           (insert "  Can't read the output\n")
  144.         (insert data)))
  145.     (get-one-string string-list (1+ i) n)))
  146.  
  147. (defun get-error-messages (error-list-desc i n)
  148.   (if (> i n)
  149.       nil
  150.     (let ((dataPtr (read-one-list-item error-list-desc i)))
  151.       (if dataPtr
  152.             (insert-reply
  153.              "  File \""
  154.              (extract-internal dataPtr 10 'pascal-string)
  155.              "\"; Line "
  156.              (prin1-to-string (extract-internal (substring dataPtr 2 4) 0 'short))
  157.              ": "
  158.              (extract-internal dataPtr 74 'pascal-string)
  159.              "\n"))
  160.       (get-error-messages error-list-desc (1+ i) n))))
  161.  
  162. (defun read-one-list-item (desc-list index)
  163.   (let* ((typeCode (make-string 4 0))
  164.          (dataSize-string (make-string 4 0))
  165.          (err (AESizeOfNthItem desc-list index typeCode dataSize-string)))
  166.     (if (not (zerop err))
  167.         nil
  168.       (let* ((theAEKeyword (make-string 4 0))
  169.              (actualSize (make-string 4 0))
  170.              (dataSize-integer (extract-internal dataSize-string 0 'long))
  171.              (dataPtr (make-string dataSize-integer 0))
  172.              (err (AEGetNthPtr desc-list index typeChar theAEKeyword
  173.                                typeCode dataPtr dataSize-integer actualSize)))
  174.         (if (not (zerop err))
  175.             nil
  176.           dataPtr)))))
  177.